home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_gen / instal11.zip / DISQUE.PAS < prev    next >
Pascal/Delphi Source File  |  1996-01-10  |  9KB  |  347 lines
  1. (*********************************)
  2. (*                               *)
  3. (* Functions to install programs *)
  4. (* version 1.00                  *)
  5. (* (c)1996 by J. BERTRAND        *)
  6. (*                               *)
  7. (* ----------------------------- *)
  8. (*                               *)
  9. (* windows function (directory)  *)
  10. (* directory functions           *)
  11. (* file functions                *)
  12. (* group & icons functions       *)
  13. (*                               *)
  14. (*********************************)
  15. unit Disque;
  16.  
  17. interface
  18.  
  19. Const DiskName = 'DISK.';
  20.  
  21. (*******************)
  22. (* extra functions *)
  23. (*******************)
  24. function WinDir : string;
  25.                   {Windows directory without '\' at the end
  26.                    none if can't find it}
  27. function SysDir : string;
  28.                   {Windows system directory without '\' at the end
  29.                    none if can't find it}
  30. function StartApp (AppName,AppParams,AppDir : string) : integer;
  31.                   {0..32 : Error look to ShellExecute for explanations of error
  32.                    other values > 32 : Ok application lauched Return = Handle of App}
  33. function CheckDsk (Path : string;Number : integer) : integer;
  34.                   {0 : OK it is the right disk in
  35.                    1 : It isn't the right disk}
  36.  
  37. (***********************)
  38. (* directory functions *)
  39. (***********************)
  40.  
  41. function CreateDirectory (DirectoryName : string) : integer;
  42.                   {0 : OK   directory created
  43.                    1 : Unable to create}
  44. function DestroyDirectory (DirectoryName : string) : integer;
  45.                   {0 : OK directory deleted
  46.                    1 : Unable to destroy}
  47.  
  48. (******************)
  49. (* file functions *)
  50. (******************)
  51.  
  52. function SizeFile (Fichier : string) : longint;
  53.                   {-2 : Unable to set size
  54.                    -1 : File doesn't exist
  55.                    >0 : Size of the file}
  56. function DeleteFile (Fichier : string) : integer;
  57.                   {0 : OK file deleted
  58.                    1 : File doesn't exist
  59.                    2 : Unable to delete}
  60. function ExistFile (Fichier : string) : integer;
  61.                   {0 : File doesn't exist
  62.                    1 : File exist}
  63. function RenameFile (OldName,NewName : string) : integer;
  64.                   {0 : OK file renammed
  65.                    1 : OldName does't exist
  66.                    2 : NewNameAlReadyExist
  67.                    3 : Unable to rename}
  68. function EnougthSpace (DriveUnit: char;Fichier : string) : integer;
  69.                   {0 : OK enougth space
  70.                    1 : File Doesn't exist
  71.                    2 : Not enougth space
  72.                    3 : Wrong letter Drive}
  73. function CopyFile (FromFile,ToFile : string;Switch : byte) : integer;
  74.                   {Switch > 0 : Don't overwrite  1 : Overwrite if exist}
  75.                   {0 : OK file copied
  76.                    1 : File already exist and Switch = 0
  77.                    2 : Unable to open Source File
  78.                    3 : Unable to open destination file
  79.                    4 : Unable to read from Source File
  80.                    5 : Unable to write to destination file}
  81.  
  82. implementation
  83.  
  84. uses SysUtils,WinProcs,DdeMan,ShellAPI,Decla,Dialogs;
  85.  
  86. (*********************)
  87. (*                   *)
  88. (* FONCTIONS EN PLUS *)
  89. (*                   *)
  90. (*********************)
  91.  
  92. (*************************)
  93. (* repertoire de windows *)
  94. (*************************)
  95. function WinDir : string;
  96. var Tmp : string;
  97.     Pas : array [0 .. 254] of char;
  98.     Siz : integer;
  99. begin
  100.  Tmp := '';
  101.  if GetWindowsDirectory(Pas,Sizeof (Pas)) <> 0 then
  102.   Tmp := StrPas (Pas);
  103.  WinDir := Tmp;
  104. end;
  105.  
  106. (*********************)
  107. (* repertoire system *)
  108. (*********************)
  109. function SysDir : string;
  110. var Tmp : string;
  111.     Pas : array [0 .. 254] of char;
  112.     Siz : integer;
  113. begin
  114.  Tmp := '';
  115.  if GetSystemDirectory (Pas,Sizeof (Pas)) <> 0 then
  116.   Tmp := StrPas (Pas);
  117.  SysDir := Tmp;
  118. end;
  119.  
  120. (*******************************)
  121. (* lancement d'une application *)
  122. (*******************************)
  123. function StartApp (AppName,AppParams,AppDir : string) : integer;
  124. var Tmp : Integer;
  125.     zFileName : array [0 .. 79] of char;
  126.     zParams   : array [0 .. 79] of char;
  127.     zDir      : array [0 .. 79] of Char;
  128. begin
  129.  Tmp := 0;
  130.  StrPCopy (zFileName,AppName);
  131.  StrPCopy (zParams,AppParams);
  132.  StrPCopy (zDir,AppDir);
  133.  Tmp := ShellExecute (0,Nil,zFileName,zParams,zDir,1);
  134.  StartApp := Tmp;
  135. end;
  136.  
  137. (********************************)
  138. (* verification d'une disquette *)
  139. (********************************)
  140. function CheckDsk (Path : string;Number : integer) : integer;
  141. var Tmp : integer;
  142.     Nbr : string [3];
  143.     Nam : string [12];
  144. begin
  145.  Tmp := 0;
  146.  str (Number:3,Nbr);
  147.  while pos (' ',Nbr) <> 0 do Nbr [pos (' ',Nbr)] := '0';
  148.  while length (Nbr) < 3 do Nbr := '0' + Nbr;
  149.  Nam := DiskName + Nbr;
  150.  if ExistFile (Path + Nam) = 0 then
  151.   Tmp := 1;
  152.  CheckDsk := Tmp;
  153. end;
  154.  
  155. (*********************************)
  156. (*                               *)
  157. (* FONCTIONS SUR LES REPERTOIRES *)
  158. (*                               *)
  159. (*********************************)
  160.  
  161. (****************************)
  162. (* creation d'un repertoire *)
  163. (****************************)
  164. function CreateDirectory (DirectoryName : string) : integer;
  165. var Tmp : integer;
  166. begin
  167.  Tmp := 0;
  168.  {$I-}; mkdir (DirectoryName) {$I+};
  169.  if ioresult <> 0 then Tmp := 1;
  170.  CreateDirectory := tmp;
  171. end;
  172.  
  173. (**************************)
  174. (* destruction repertoire *)
  175. (**************************)
  176. function DestroyDirectory (DirectoryName : string) : integer;
  177. var Tmp : integer;
  178. begin
  179.  Tmp := 0;
  180.  {$I-}; RmDir (DirectoryName); {$I+};
  181.  if ioresult <> 0 then Tmp := 1;
  182.  DestroyDirectory := Tmp;
  183. end;
  184.  
  185. (******************************)
  186. (*                            *)
  187. (* FONCTIONS SUR LES FICHIERS *)
  188. (*                            *)
  189. (******************************)
  190.  
  191. (***********************)
  192. (* taille d'un fichier *)
  193. (***********************)
  194. function SizeFile (Fichier : string) : longint;
  195. var Tmp : longint;
  196.     Siz : longint;
  197.     Fch : file;
  198. begin
  199.  if ExistFile (Fichier) = 0 then
  200.   Tmp := -1
  201.  else
  202.  begin
  203.   assign (Fch,Fichier);
  204.   {$I-}; Siz := FileSize (Fch); {$I+};
  205.   if ioresult <> 0 then Tmp := -2
  206.                    else Tmp := Siz;
  207.  end;
  208.  SizeFile := Tmp;
  209. end;
  210.  
  211. (*********************)
  212. (* efface un fichier *)
  213. (*********************)
  214. function DeleteFile (Fichier : string) : integer;
  215. var Tmp : integer;
  216.     Fch : file;
  217. begin
  218.  Tmp := 0;
  219.  if ExistFile (Fichier) = 0 then
  220.   Tmp := 1
  221.  else
  222.  begin
  223.   Assign (Fch,Fichier);
  224.   {$I-}; Erase (Fch); {$I+};
  225.   if ioresult <> 0 then Tmp := 2;
  226.  end;
  227.  DeleteFile := Tmp;
  228. end;
  229.  
  230. (******************************)
  231. (* teste si un fichier existe *)
  232. (******************************)
  233. function ExistFile (Fichier : string) : integer;
  234. var Fch : file;
  235.     Tmp : integer;
  236. begin
  237.  Tmp := 1;
  238.  assign (Fch,Fichier);
  239.  {$I-}; reset (Fch); {$I+};
  240.  if ioresult = 0 then Close (Fch)
  241.                  else Tmp := 0;
  242.  ExistFile := Tmp;
  243. end;
  244.  
  245. (**********************)
  246. (* renomme un fichier *)
  247. (**********************)
  248. function RenameFile (OldName,NewName : string) : integer;
  249. var Tmp : integer;
  250.     Fch : file;
  251. begin
  252.  Tmp := 0;
  253.  if ExistFile (OldName) = 1 then
  254.   Tmp := 1
  255.  else
  256.   if ExistFile (NewName) = 1 then
  257.    Tmp := 2
  258.   else
  259.   begin
  260.    assign (Fch,OldName);
  261.    {$I-}; rename (Fch,NewName) {$I+};
  262.    if ioresult <> 0 then Tmp := 3;
  263.   end;
  264.  RenameFile := Tmp;
  265. end;
  266.  
  267. (***************************)
  268. (* y a t il assez de place *)
  269. (***************************)
  270. function EnougthSpace (DriveUnit : char;Fichier : string) : integer;
  271. var Tmp : integer;
  272.     Siz : longint;
  273.     Dsk : integer;
  274.     DFr : longint;
  275. begin
  276.  Tmp := 0;
  277.  Dsk := ord (upcase (DriveUnit)) - 64;
  278.  if Dsk < 1 then
  279.   Tmp := 3
  280.  else
  281.  begin
  282.   if ExistFile (Fichier) = 0 then
  283.    Tmp := 1
  284.   else
  285.   begin
  286.    Siz := SizeFile (Fichier);
  287.    if Siz > -1 then
  288.    begin
  289.     DFr := DiskFree (Dsk);
  290.     if Dfr < 0 then
  291.      tmp := 3
  292.     else
  293.      if Siz > DiskFree (Dsk) then Tmp := 2;
  294.    end;
  295.   end;
  296.  end;
  297.  EnougthSpace := Tmp;
  298. end;
  299.  
  300. (**********************)
  301. (* copie d'un fichier *)
  302. (**********************)
  303. function CopyFile (FromFile,ToFile : string ; Switch : byte) : integer;
  304. var Tmp : integer;
  305.     FromF, ToF: file;
  306.     NumRead, NumWritten: Word;
  307.     Buf: array[1..4096] of Char;
  308. begin
  309.  Tmp := 0;
  310.  If (ExistFile (ToFile) = 1) and (Switch = 0) then
  311.   Tmp := 1
  312.  else
  313.  begin
  314.   System.Assign(FromF,FromFile);
  315.   {$I-}; System.Reset(FromF, 1); {$I+};
  316.   if ioresult = 0 then
  317.   begin
  318.    System.Assign(ToF,ToFile);
  319.    {$I-};System.Rewrite(ToF, 1); {$I+};
  320.    if ioresult = 0 then
  321.    begin
  322.     repeat
  323.      {$I-}; System.BlockRead(FromF, Buf, SizeOf(Buf), NumRead); {$I+};
  324.      if ioresult = 0 then
  325.      begin
  326.       {$I-};System.BlockWrite(ToF, Buf, NumRead, NumWritten); {$I+};
  327.       if ioresult <> 0 then
  328.        Tmp := 5;
  329.      end
  330.      else
  331.       Tmp := 4;
  332.     until (NumRead = 0) or (NumWritten <> NumRead);
  333.     System.Close(ToF);
  334.    end
  335.    else
  336.     Tmp := 3;
  337.    System.Close(FromF);
  338.   end
  339.   else
  340.    Tmp := 2;
  341.  end;
  342.  CopyFile := Tmp;
  343. end;
  344.  
  345. end.
  346.  
  347.